home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86oct.arc / ALLOC.ARC / A2TEST.MOD < prev    next >
Text File  |  1985-07-12  |  4KB  |  189 lines
  1. MODULE alloc2test;
  2.  
  3. FROM Alloc2 IMPORT blockPtr, allocate, free, setWord, getWord, blockSize,
  4.     getFreeList;
  5. FROM MyTerminal IMPORT WriteString, Write, WriteLnString, WriteLn,
  6.     WriteCard, fatal, pause, ClearScreen, Read;
  7. FROM SYSTEM IMPORT WORD, ADDRESS;
  8. FROM InOut IMPORT ReadCard;
  9. FROM MachineSpecific IMPORT writeAddress;
  10.  
  11. CONST maxIndex = 32767;
  12.  
  13. TYPE bPtr = POINTER TO block;
  14.     block = RECORD
  15.          size:CARDINAL;
  16.          CASE BOOLEAN OF
  17.             TRUE: nextBlock: bPtr;
  18.          |  FALSE: contents:ARRAY[0..maxIndex] OF WORD;
  19.          END;
  20.          END;
  21.  
  22. VAR blockList:ARRAY['a'..'z'] OF blockPtr;
  23.  
  24. PROCEDURE rawPrintBlockHeader(blockp:bPtr);
  25. BEGIN
  26.     WriteLnString("---------------------");
  27.     IF ADDRESS(blockp) = NIL THEN
  28.     WriteLnString("NIL");
  29.     ELSE
  30.     WriteString("Block (raw) ");
  31.     writeAddress(ADDRESS(blockp));
  32.     WriteString("  (");
  33.     WriteCard(blockp^.size, 0); 
  34.     WriteLnString(" words)");
  35.     END;
  36. END rawPrintBlockHeader;
  37.  
  38. PROCEDURE rawPrintBlock(blockp:bPtr);
  39. VAR i:CARDINAL;
  40. BEGIN
  41.     rawPrintBlockHeader(blockp);
  42.     IF blockp <> NIL THEN
  43.     WITH blockp^ DO
  44.         FOR i := 0 TO size-1 DO
  45.         WriteCard(i, 3); WriteString(': ');
  46.         WriteCard(CARDINAL(contents[i]), 0); WriteLn;
  47.         END;
  48.     END;
  49.     END;
  50. END rawPrintBlock;
  51.  
  52. PROCEDURE printBlockHeader(blockp:blockPtr);
  53. BEGIN
  54.     WriteLnString("---------------------");
  55.     IF ADDRESS(blockp) = NIL THEN
  56.     WriteLnString("NIL");
  57.     ELSE
  58.     WriteString("Block ");
  59.     writeAddress(ADDRESS(blockp));
  60.     WriteString("  (");
  61.     WriteCard(blockSize(blockp), 0); 
  62.     WriteLnString(" words)");
  63.     END;
  64. END printBlockHeader; 
  65.  
  66. PROCEDURE printBlock(blockp:blockPtr);
  67. VAR i:CARDINAL;
  68. BEGIN
  69.     printBlockHeader(blockp);
  70.     IF ADDRESS(blockp) <> NIL THEN
  71.     FOR i := 0 TO blockSize(blockp)-1 DO
  72.         WriteCard(i, 3); WriteString(': ');
  73.         WriteCard(CARDINAL(getWord(blockp, i)), 0); WriteLn;
  74.     END;
  75.     END;
  76. END printBlock;
  77.  
  78. PROCEDURE rawPrintFreeList;
  79. VAR bp:bPtr;
  80. BEGIN
  81.     bp := bPtr(getFreeList());
  82.     WHILE bp <> NIL DO
  83.     rawPrintBlockHeader(bp);
  84.     bp := bp^.nextBlock;
  85.     END;
  86.     WriteLnString("---------------------");
  87. END rawPrintFreeList;
  88.  
  89. PROCEDURE printFreeList;
  90. VAR bp:blockPtr;
  91.     bptr:bPtr;
  92. BEGIN
  93.     bp := getFreeList();
  94.     WHILE ADDRESS(bp) <> NIL DO
  95.     printBlockHeader(bp);
  96.     bptr := bPtr(bp);
  97.     bp := blockPtr(bptr^.nextBlock);
  98.     END;
  99.     WriteLnString("---------------------");
  100. END printFreeList;
  101.  
  102. PROCEDURE test;
  103. VAR c1, c2:CHAR;
  104. BEGIN
  105.     LOOP
  106.     Write('>');
  107.     Read(c1); Write(c1);
  108.     Read(c2); Write(c2);
  109.     CASE c1 OF
  110.         'a': doAlloc(c2);
  111.     |   'f': doFree(c2);
  112.     |   'r': IF letter(c2) THEN 
  113.             rawPrintBlock(bPtr(blockList[c2]));
  114.          ELSE 
  115.             rawPrintFreeList;
  116.          END;
  117.     |   'p': IF letter(c2) THEN
  118.             printBlock(blockList[c2]);
  119.          ELSE 
  120.             printFreeList;
  121.          END;
  122.     |   's': doSet(c2);
  123.     |   'g': doGet(c2);
  124.     |   'c': doCopy(c2);
  125.     |   'q': EXIT;
  126.     ELSE
  127.     WriteLnString("a)lloc, f)ree, p)rint, r)aw print, qu)it, s)et, g)et,");
  128.     WriteLnString("c)opy");
  129.     END;
  130.     END;
  131. END test;
  132.    
  133. PROCEDURE doCopy(source:CHAR);
  134. VAR dest:CHAR;
  135. BEGIN
  136.     WriteString("Copy to: ");
  137.     Read(dest);
  138.     blockList[dest] := blockList[source];
  139. END doCopy;
  140.  
  141. PROCEDURE doAlloc(b:CHAR);       
  142. BEGIN
  143.     blockList[b] := allocate(getCard("Number of words: "));
  144. END doAlloc;
  145.  
  146. PROCEDURE doFree(b:CHAR);
  147. BEGIN
  148.     free(blockList[b]);
  149. END doFree;
  150.  
  151. PROCEDURE doSet(b:CHAR);
  152. BEGIN
  153.     setWord(blockList[b], getCard("Position: "), getCard("Value: "));
  154. END doSet;
  155.  
  156. PROCEDURE doGet(b:CHAR);
  157. BEGIN
  158.     WriteCard(CARDINAL(getWord(blockList[b], getCard("Position: "))), 0);
  159. END doGet; 
  160.  
  161. PROCEDURE getCard(s:ARRAY OF CHAR):CARDINAL;
  162. VAR c:CARDINAL;
  163. BEGIN
  164.     WriteString(s);
  165.     ReadCard(c);
  166.     WriteLn;
  167.     RETURN c;
  168. END getCard;
  169.  
  170. PROCEDURE letter(c:CHAR):BOOLEAN;
  171. BEGIN
  172.     RETURN (c >= 'a') AND (c <= 'z');
  173. END letter;
  174.  
  175. PROCEDURE init;
  176. VAR c:CHAR;
  177. BEGIN
  178.     FOR c := 'a' TO 'z' DO
  179.     blockList[c] := blockPtr(NIL);
  180.     END;
  181. END init;
  182.  
  183. BEGIN
  184.     ClearScreen;
  185.     init;
  186.     test;
  187. END alloc2test.
  188. z' DO
  189.     bloc